(FILECREATED "15-APR-74 05:59:51" CL

     changes to:  CLEXPAND

     previous date: "15-APR-74 03:31:58")


  (LISPXPRINT (QUOTE CLVARS)
	      T)
  (RPAQQ CLVARS ((FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS 
		      CLCREATE CLINSERT CLEQUALPARTS CLEXPAND)))
(DEFINEQ

(CLDIFF
(LAMBDA (CL1 CL2) (COND ((NULL CL2) CL1) ((NULL CL1) NIL) (T (for PR in CL1
bind N when (IGREATERP (SETQ N (IDIFFERENCE (CDR PR) (LMASSOC (CAR PR) CL2
0))) 0) collect (CONS (CAR PR) N))))))

(CLCOUNT
(LAMBDA (CL) (for PR in CL sum (CDR PR))))

(CLPARTS
(LAMBDA (CL PARTSIZE) (COND ((ZEROP PARTSIZE) (LIST NIL)) ((NULL (CDR CL))
(COND ((EQ PARTSIZE (CDAR CL)) (LIST CL)) (T (LIST (LIST (CONS (CAAR CL) 
PARTSIZE)))))) (T (bind ((MAX1← (IMIN PARTSIZE (CDAR CL)))) for NUMBER.CAR.CL
from (IMAX (IDIFFERENCE PARTSIZE (CLCOUNT (CDR CL))) 0) to MAX1 join (for
PART in (CLPARTS (CDR CL) (IDIFFERENCE PARTSIZE NUMBER.CAR.CL)) rcollect (COND
((ZEROP NUMBER.CAR.CL) PART) (T (CONS (CONS (CAAR CL) NUMBER.CAR.CL) PART))))))))
)

(CLPARTITIONSN
(LAMBDA (CL N MINPARTSIZE MAXPARTSIZE) (for PARTSIZES in (NUMPARTITIONS (CLCOUNT
CL) N MINPARTSIZE MAXPARTSIZE) join (CLPARTITIONS CL PARTSIZES))))

(CLPARTITIONS
(LAMBDA (CL PARTSIZES) (COND ((NULL (CDR PARTSIZES)) (LIST (LIST CL))) ((ZEROP
(CAR PARTSIZES)) (for X in (CLPARTITIONS CL (CDR PARTSIZES)) collect (CONS
NIL X))) ((EQ (CAR PARTSIZES) (CADR PARTSIZES)) (PROG (N THISPART) (SETQ N
1) (SETQ THISPART (CAR PARTSIZES)) (while (AND (SETQ PARTSIZES (CDR PARTSIZES))
(EQ (CAR PARTSIZES) THISPART)) do (SETQ N (ADD1 N))) (COND ((NULL PARTSIZES)
(RETURN (CLEQUALPARTS CL N THISPART)))) (RETURN (for BIGPART in (CLPARTS CL
(ITIMES N THISPART)) bind RESTPARTSLIST eachtime (SETQ RESTPARTSLIST (
CLPARTITIONS (CLDIFF CL BIGPART) PARTSIZES)) join (for LITTLEPARTS in (
CLEQUALPARTS BIGPART N THISPART) join (for RESTPARTS in RESTPARTSLIST rcollect
(APPEND LITTLEPARTS RESTPARTS))))))) (T (for PART in (CLPARTS CL (CAR PARTSIZES))
join (for PARTS in (CLPARTITIONS (CLDIFF CL PART) (CDR PARTSIZES)) rcollect
(CONS PART PARTS)))))))

(CLCREATE
(LAMBDA (L) (PROG (CL) (for X in L do (SETQ CL (CLINSERT X CL))) (RETURN CL))))

(CLINSERT
(LAMBDA (ITEM CL) (COND ((NULL CL) (LIST (CONS ITEM 1))) ((EQUAL ITEM (CAAR
CL)) (RPLACD (CAR CL) (ADD1 (CDAR CL))) CL) ((ORDERED ITEM (CAAR CL)) (CONS
(CONS ITEM 1) CL)) (T (RPLACD CL (CLINSERT ITEM (CDR CL)))))))

(CLEQUALPARTS
(LAMBDA (CL NPARTS PARTSIZE) (COND ((ZEROP NPARTS) (QUOTE (NIL))) ((NULL (CDR
CL)) (SETQ CL (COND ((NOT (ZEROP PARTSIZE)) (LIST (CONS (CAAR CL) PARTSIZE)))
(T NIL))) (LIST (to NPARTS collect CL))) (T (for X in (NUMPARTITIONS (CDAR
CL) NPARTS 0 PARTSIZE) join (for Y in (CLPARTITIONS (CDR CL) (for XX in X
collect (IDIFFERENCE PARTSIZE XX))) collect (for XX in X as YY in Y collect
(COND ((ZEROP XX) YY) (T (CONS (CONS (CAAR CL) XX) YY))))))))))

(CLEXPAND
  [LAMBDA (CL)
    (for X in CL join (LISTOF (CDR X)
			      (CAR X])
)
STOP